home *** CD-ROM | disk | FTP | other *** search
/ Softdisk Supreme / Softdisk Supreme.iso / pc / DSK Files / 0-49 / SD005b.dsk / JUMBLER.bas < prev    next >
BASIC Source File  |  2003-06-12  |  6KB  |  151 lines
  1. 20  DIM J$(40)
  2. 30  TEXT 
  3. 50  HOME : VTAB 10: HTAB 12: PRINT "JUMBLER / UNJUMBLER": PRINT : HTAB 7: PRINT "BY DANIEL TOBIAS     JAN. 1982"
  4. 60  PRINT : HTAB 7: INPUT "(J)UMBLE OR (U)NJUMBLE? ";I$
  5. 70  IF  LEFT$(I$,1) = "J"  THEN 10000
  6. 100  REM  START
  7. 105 T = 1
  8. 110  HOME : PRINT 
  9. 115  PRINT "ENTER JUMBLE YOU WANT TO SOLVE:": GOSUB 500:J$ = I$
  10. 120  IF J$ = ""  THEN 115
  11. 125 JU$ = J$
  12. 130  REM 
  13. 135 K$ = "": FOR A = 1 TO  LEN(J$)
  14. 140  IF  MID$ (J$,A,1) < >" "  THEN K$ = K$ +"-"
  15. 145  NEXT A: HOME 
  16. 150  HTAB 1: VTAB 6: PRINT "JUMBLED STRING:": HTAB 1: VTAB 10: PRINT "UNJUMBLED STRING:"
  17. 152  HTAB 1: VTAB 16: PRINT "==========================": PRINT " CTRL-I: INSERT SPACE": PRINT " CTRL-D: DELETE CHARACTER"
  18. 153  PRINT " ARROWS: MOVE CURSOR"
  19. 154  PRINT " RETURN: EXIT PROGRAM"
  20. 155  REM 
  21. 160  GOSUB 1000
  22. 165 F = 0: FOR B = 1 TO  LEN(J$)
  23. 170  IF I$ =  MID$ (J$,B,1)  AND F = 0  THEN  GOSUB 200
  24. 175 I = T
  25. 180  NEXT B: IF F = 0  THEN  VTAB 14: HTAB 1: PRINT "THERE IS NO '"I$"'.": CALL  -868:I$ = "-": GOSUB 300: GOTO 155
  26. 185 T = T +1
  27. 190  GOSUB 300: GOTO 155
  28. 200  REM  INSERT *
  29. 210 F = 1
  30. 220  IF B = 1  THEN J$ = "*" + MID$ (J$,2)
  31. 230  IF B =  LEN(J$)  THEN J$ =  LEFT$(J$, LEN(J$) -1) +"*"
  32. 240  IF B >1  AND B < LEN(J$)  THEN J$ =  LEFT$(J$,B -1) +"*" + MID$ (J$,B +1)
  33. 250  RETURN 
  34. 300  REM  UPDATE SOLVING $
  35. 310  IF I = 1  THEN K$ = I$ + MID$ (K$,2)
  36. 320  IF I > =  LEN(K$)  THEN K$ =  LEFT$(K$, LEN(K$) -1) +I$
  37. 330  IF I >1  AND I < LEN(K$)  THEN K$ =  LEFT$(K$,I -1) +I$ + MID$ (K$,I +1)
  38. 340  RETURN 
  39. 500  REM INPUT
  40. 505 I$ = ""
  41. 510  GET A$
  42. 520  IF A$ =  CHR$(8)  THEN  GOSUB 555: GOTO 510
  43. 522  IF  LEN(I$) >38  AND A$ < > CHR$(13)  THEN  PRINT "<CTRL-G>";: GOTO 510
  44. 523  IF A$ =  CHR$(13)  THEN  PRINT : RETURN 
  45. 524  IF A$ = "*"  OR A$ = "-"  OR A$ <" "  THEN  PRINT "<CTRL-G>";: GOTO 510
  46. 525  PRINT A$;
  47. 545 I$ = I$ +A$
  48. 550  GOTO 510
  49. 555  REM <--
  50. 560  IF I$ = ""  THEN  RETURN 
  51. 565  IF  LEN(I$) = 1  THEN I$ = ""
  52. 570  IF  LEN(I$) >1  THEN I$ =  LEFT$(I$, LEN(I$) -1)
  53. 575  PRINT A$;: CALL  -868: RETURN 
  54. 700  REM GET RID OF THE RIGHTMOST -
  55. 705 D = 0
  56. 710  IF  RIGHT$(K$,1) = "-"  THEN K$ =  LEFT$(K$, LEN(K$) -1): RETURN 
  57. 720 X =  LEN(K$) -1
  58. 730  IF  MID$ (K$,X,1) = "-"  THEN K$ =  LEFT$(K$,X -1) + MID$ (K$,X +1): RETURN 
  59. 740 X = X -1
  60. 745  IF (X <T)  AND D = 0  THEN T = T -1:D = 1
  61. 750  IF X >1  THEN 730
  62. 760  IF  LEFT$(K$,1) = "-"  THEN K$ =  MID$ (K$,2): RETURN 
  63. 765  IF D = 1  THEN T = T +1
  64. 770  VTAB 14: HTAB 1: PRINT "NO MORE LETTERS.": POP : GOTO 1000
  65. 1000  REM  WAIT FOR INPUT
  66. 1005  HTAB 1: VTAB 8: PRINT J$;: CALL  -868: HTAB 1: VTAB 12: PRINT K$;: CALL  -868
  67. 1010  IF T <1  THEN T = 1
  68. 1020  IF T > LEN(K$)  THEN T =  LEN(K$)
  69. 1025 I = T
  70. 1030  VTAB 12: HTAB T
  71. 1040  GET I$
  72. 1042  IF I$ = "*"  THEN 1040
  73. 1045  VTAB 14: HTAB 1: CALL  -868
  74. 1050  IF I$ =  CHR$(21)  THEN T = T +1: GOTO 1000
  75. 1060  IF I$ =  CHR$(8)  THEN T = T -1: GOTO 1000
  76. 1070  IF I$ =  CHR$(13)  THEN 9000
  77. 1075  IF I$ = " "  AND  MID$ (K$,T,1) < >"-"  AND  MID$ (K$,T,1) < >" "  THEN  GOSUB 4000: GOSUB 300:K$ = K$ +"-"
  78. 1080  IF I$ = " "  AND  MID$ (K$,T,1) = "-"  THEN  GOSUB 300:K$ = K$ +"-"
  79. 1085  IF I$ = " "  THEN T = T +1
  80. 1087  IF T > LEN(K$)  THEN 1000
  81. 1090  IF I$ = "<CTRL-D>"  AND  MID$ (K$,T,1) = " "  THEN  GOSUB 3000: GOTO 1000
  82. 1092  IF I$ = "<CTRL-D>"  AND  MID$ (K$,T,1) = "-"  THEN  GOSUB 3000:K$ = K$ +"-": GOTO 1000
  83. 1095  IF I$ = "-"  AND  MID$ (K$,T,1) < >" "  THEN  GOSUB 4000
  84. 1097  IF I$ = "-"  AND  MID$ (K$,T,1) = " "  THEN  GOSUB 700:I = T: GOSUB 300
  85. 1098  IF I$ = "-"  THEN T = T +1: GOTO 1000
  86. 1099  IF T > LEN(K$)  THEN 1000
  87. 1100 I =  ASC(I$): IF I >32  AND  MID$ (K$,T,1) = "-"  AND I$ < >"-"  THEN  RETURN 
  88. 1110  IF I >32  AND  MID$ (K$,T,1) = " "  AND I$ < >"-"  THEN  GOSUB 700: RETURN 
  89. 1120  IF I >32  AND  ASC( MID$ (K$,T,1)) >32  AND I$ < >"-"  THEN  GOSUB 4000: RETURN 
  90. 1130  IF I$ = "<CTRL-D>"  AND  ASC( MID$ (K$,T,1)) >32  THEN  GOSUB 4000: GOSUB 3000:K$ = K$ +"-"
  91. 1140  IF I$ = "<CTRL-I>"  THEN  GOSUB 2000
  92. 1990  GOTO 1000
  93. 2000  REM  ADD SPACE
  94. 2010  IF T = 1  THEN K$ = " " +K$
  95. 2020  IF T >1  THEN K$ =  LEFT$(K$,T -1) +" " + MID$ (K$,T)
  96. 2030  RETURN 
  97. 3000  REM  REMOVE SPACE
  98. 3005 L =  LEN(K$)
  99. 3010  IF T = 1  THEN K$ =  MID$ (K$,2)
  100. 3020  IF T = L  THEN K$ =  LEFT$(K$, LEN(K$) -1)
  101. 3030  IF T >1  AND T <L  THEN K$ =  LEFT$(K$,T -1) + MID$ (K$,T +1)
  102. 3040  RETURN 
  103. 4000  REM  ELIMINATE
  104. 4005 D = 0
  105. 4010 O$ =  MID$ (K$,T,1)
  106. 4020  FOR A = 1 TO  LEN(JU$)
  107. 4030  IF  MID$ (JU$,A,1) = O$  AND  MID$ (J$,A,1) = "*"  AND D = 0  THEN  GOSUB 4500:D = 1
  108. 4040  NEXT A
  109. 4050 I = T: GOSUB 300
  110. 4060  RETURN 
  111. 4500  REM 
  112. 4510  IF A = 1  THEN J$ =  LEFT$(JU$,1) + MID$ (J$,2)
  113. 4520  IF A =  LEN(J$)  THEN J$ =  LEFT$(J$,A -1) + MID$ (JU$,A,1)
  114. 4530  IF A >1  AND A < LEN(J$)  THEN J$ =  LEFT$(J$,A -1) + MID$ (JU$,A,1) + MID$ (J$,A +1)
  115. 4540  RETURN 
  116. 9000  REM  END
  117. 9010  TEXT : HOME 
  118. 9020  PRINT : PRINT "JUMBLE:": PRINT JU$: PRINT : PRINT "YOUR SOLUTION:": PRINT K$: PRINT 
  119. 9025 J$ = JU$:T = 1
  120. 9030  INPUT "DO YOU WANT TO DO THE SAME JUMBLE OVER  AGAIN? (Y/N) :";I$
  121. 9035  PRINT 
  122. 9040  IF  LEFT$(I$,1) = "Y"  THEN 130
  123. 9050  INPUT "DO YOU WANT TO RUN THE PROGRAM AGAIN?   (Y/N) :";I$: PRINT 
  124. 9060  IF  LEFT$(I$,1) = "Y"  THEN  RUN 
  125. 9070  PRINT "SO LONG."
  126. 9080  END 
  127. 10000  REM  JUMBLE
  128. 10010  HOME : PRINT 
  129. 10020  PRINT "ENTER LINE YOU WANT JUMBLED."
  130. 10030  GOSUB 500:J$ = I$
  131. 10040  IF J$ = ""  THEN 10030
  132. 10050 K$ =  LEFT$("                                          ", LEN(J$))
  133. 10055 N =  LEN(J$)
  134. 10057  FOR J = 1 TO  LEN(J$):J$(J) = "": NEXT J
  135. 10060  FOR J = 1 TO  LEN(J$)
  136. 10070 R =  INT(N * RND(1)) +1
  137. 10080 A = 1
  138. 10090 C = 0
  139. 10100  IF J$(A) = ""  THEN C = C +1
  140. 10110  IF C = R  THEN 10200
  141. 10120 A = A +1: GOTO 10100
  142. 10200 J$(A) =  MID$ (J$,J,1)
  143. 10230 N = N -1: NEXT J
  144. 10232 K$ = ""
  145. 10235  FOR A = 1 TO  LEN(J$):K$ = K$ +J$(A): NEXT A
  146. 10240  PRINT : PRINT "YOUR MESSAGE JUMBLED:"
  147. 10250 J$ = K$: PRINT J$
  148. 10255 JU$ = J$
  149. 10260  PRINT : INPUT "RUN UNJUMBLER WITH THIS JUMBLE (Y/N)    :";I$: PRINT : IF  LEFT$(I$,1) = "Y"  THEN 130
  150. 10270  INPUT "RUN THE PROGRAM AGAIN? (Y/N) :";I$: PRINT : IF  LEFT$(I$,1) = "Y"  THEN  RUN 
  151. 10280  PRINT "SO LONG.": END